home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / dpassb5.f < prev    next >
Text File  |  1989-08-14  |  3KB  |  85 lines
  1.       subroutine dpassb5 (ido,l1,cc,ch,wa1,wa2,wa3,wa4)
  2. c
  3. c     Double precision version.  -tk
  4. c
  5. C***BEGIN PROLOGUE  DPASSB5
  6. C***REFER TO DCFFTB
  7. C***ROUTINES CALLED  (NONE)
  8. C***END PROLOGUE  DPASSB5
  9.       implicit double precision (a-h,o-z)
  10.       dimension       cc(ido,5,l1)           ,ch(ido,l1,5)           ,
  11.      1                wa1(1)     ,wa2(1)     ,wa3(1)     ,wa4(1)
  12.       data tr11,ti11,tr12,ti12 /.309016994374947,.951056516295154,
  13.      1-.809016994374947,.587785252292473/
  14. C***FIRST EXECUTABLE STATEMENT  DPASSB5
  15.       if (ido .ne. 2) go to 102
  16.       do 101 k=1,l1
  17.          ti5 = cc(2,2,k)-cc(2,5,k)
  18.          ti2 = cc(2,2,k)+cc(2,5,k)
  19.          ti4 = cc(2,3,k)-cc(2,4,k)
  20.          ti3 = cc(2,3,k)+cc(2,4,k)
  21.          tr5 = cc(1,2,k)-cc(1,5,k)
  22.          tr2 = cc(1,2,k)+cc(1,5,k)
  23.          tr4 = cc(1,3,k)-cc(1,4,k)
  24.          tr3 = cc(1,3,k)+cc(1,4,k)
  25.          ch(1,k,1) = cc(1,1,k)+tr2+tr3
  26.          ch(2,k,1) = cc(2,1,k)+ti2+ti3
  27.          cr2 = cc(1,1,k)+tr11*tr2+tr12*tr3
  28.          ci2 = cc(2,1,k)+tr11*ti2+tr12*ti3
  29.          cr3 = cc(1,1,k)+tr12*tr2+tr11*tr3
  30.          ci3 = cc(2,1,k)+tr12*ti2+tr11*ti3
  31.          cr5 = ti11*tr5+ti12*tr4
  32.          ci5 = ti11*ti5+ti12*ti4
  33.          cr4 = ti12*tr5-ti11*tr4
  34.          ci4 = ti12*ti5-ti11*ti4
  35.          ch(1,k,2) = cr2-ci5
  36.          ch(1,k,5) = cr2+ci5
  37.          ch(2,k,2) = ci2+cr5
  38.          ch(2,k,3) = ci3+cr4
  39.          ch(1,k,3) = cr3-ci4
  40.          ch(1,k,4) = cr3+ci4
  41.          ch(2,k,4) = ci3-cr4
  42.          ch(2,k,5) = ci2-cr5
  43.   101 continue
  44.       return
  45.   102 do 104 k=1,l1
  46.          do 103 i=2,ido,2
  47.             ti5 = cc(i,2,k)-cc(i,5,k)
  48.             ti2 = cc(i,2,k)+cc(i,5,k)
  49.             ti4 = cc(i,3,k)-cc(i,4,k)
  50.             ti3 = cc(i,3,k)+cc(i,4,k)
  51.             tr5 = cc(i-1,2,k)-cc(i-1,5,k)
  52.             tr2 = cc(i-1,2,k)+cc(i-1,5,k)
  53.             tr4 = cc(i-1,3,k)-cc(i-1,4,k)
  54.             tr3 = cc(i-1,3,k)+cc(i-1,4,k)
  55.             ch(i-1,k,1) = cc(i-1,1,k)+tr2+tr3
  56.             ch(i,k,1) = cc(i,1,k)+ti2+ti3
  57.             cr2 = cc(i-1,1,k)+tr11*tr2+tr12*tr3
  58.             ci2 = cc(i,1,k)+tr11*ti2+tr12*ti3
  59.             cr3 = cc(i-1,1,k)+tr12*tr2+tr11*tr3
  60.             ci3 = cc(i,1,k)+tr12*ti2+tr11*ti3
  61.             cr5 = ti11*tr5+ti12*tr4
  62.             ci5 = ti11*ti5+ti12*ti4
  63.             cr4 = ti12*tr5-ti11*tr4
  64.             ci4 = ti12*ti5-ti11*ti4
  65.             dr3 = cr3-ci4
  66.             dr4 = cr3+ci4
  67.             di3 = ci3+cr4
  68.             di4 = ci3-cr4
  69.             dr5 = cr2+ci5
  70.             dr2 = cr2-ci5
  71.             di5 = ci2-cr5
  72.             di2 = ci2+cr5
  73.             ch(i-1,k,2) = wa1(i-1)*dr2-wa1(i)*di2
  74.             ch(i,k,2) = wa1(i-1)*di2+wa1(i)*dr2
  75.             ch(i-1,k,3) = wa2(i-1)*dr3-wa2(i)*di3
  76.             ch(i,k,3) = wa2(i-1)*di3+wa2(i)*dr3
  77.             ch(i-1,k,4) = wa3(i-1)*dr4-wa3(i)*di4
  78.             ch(i,k,4) = wa3(i-1)*di4+wa3(i)*dr4
  79.             ch(i-1,k,5) = wa4(i-1)*dr5-wa4(i)*di5
  80.             ch(i,k,5) = wa4(i-1)*di5+wa4(i)*dr5
  81.   103    continue
  82.   104 continue
  83.       return
  84.       end
  85.